home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / wipeab_1 / module1.bas < prev    next >
BASIC Source File  |  1999-08-09  |  3KB  |  65 lines
  1. Attribute VB_Name = "Module1"
  2. Type POINTAPI
  3.         X As Long
  4.         Y As Long
  5. End Type
  6.  
  7. Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName$, ByVal lpDeviceName$, ByVal lpOutput$, ByVal lpInitData&)
  8. Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  9. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  10. Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Any) As Long
  11. Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  12. Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  13.  
  14. Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  15. Public Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
  16. Public Const SRCINVERT = &H660046  ' (DWORD) dest = source Invert dest
  17.  
  18. Public Function degtorad(ang)
  19.    degtorad = ang * 0.0174 ' =  (ang / 180) * 3.14159265359
  20. End Function
  21.  
  22. Public Sub DirectLoadPicture(filename As String, DC As Long, bmp As Long, w, h As Integer, frm1 As Form)
  23.  
  24. Dim olderBMP As Long
  25. Dim pic As StdPicture
  26. Dim TDC As Long
  27. Dim w1, h1 As Long
  28. Dim hdcCompatible As Long
  29. Dim hbmScreen As Long
  30.  
  31. If filename <> "" Then
  32.  'If Filename is given, load the picture,create a DC and blits it
  33.  Set pic = LoadPicture(filename)
  34.  TDC = CreateCompatibleDC(frm1.hDC)
  35.  OldBMP = SelectObject(TDC, pic.Handle)
  36.  w = frm1.ScaleX(pic.Width, vbHimetric, vbPixels)
  37.  h = frm1.ScaleX(pic.Height, vbHimetric, vbPixels)
  38.  w1 = w
  39.  h1 = h
  40.  hdcCompatible = CreateCompatibleDC(frm1.hDC)                   'Create the DC
  41.  hbmScreen = CreateCompatibleBitmap(frm1.hDC, w1, h1)  'Temporary bitmap
  42.  If SelectObject(hdcCompatible, hbmScreen) = vbNull Then         'If the function fails
  43.    DC = vbNull                                              ' return null
  44.  Else                                                            'If it succeeds
  45.    DC = hdcCompatible                                       ' return the DC
  46.  End If
  47.  olderBMP = SelectObject(DC, bmp)
  48.  BitBlt DC, 0, 0, w, h, TDC, 0, 0, SRCCOPY
  49.  olderBMP = SelectObject(DC, olderBMP)
  50.  OldBMP = SelectObject(TDC, OldBMP)
  51.  ret% = DeleteDC(TDC)
  52.  Set pic = Nothing 'Release temporary pictures
  53. Else
  54.  'If no Filename is given, create empty DC with width W and height h
  55.  hdcCompatible = CreateCompatibleDC(frm1.hDC)                   'Create the DC
  56.  hbmScreen = CreateCompatibleBitmap(frm1.hDC, w, h)   'Temporary bitmap
  57.  If SelectObject(hdcCompatible, hbmScreen) = vbNull Then         'If the function fails
  58.     DC = vbNull                                              ' return null
  59.  Else                                                            'If it succeeds
  60.     DC = hdcCompatible                                       ' return the DC
  61.  End If
  62. End If
  63. End Sub
  64.  
  65.